home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus Special 17 / AMIGAplus Sonderheft 17 (1999)(ICP)(DE)[!].iso / Rexx / TestNets.AmiCAD < prev    next >
Text File  |  1998-08-08  |  8KB  |  289 lines
  1. /* Test des erreurs sur un schéma, dans le but de créer une netlist */
  2. /* $VER: TestNets 1.00 (© R.Florac, 14 Juillet 1998) */
  3.  
  4. options results     /* indispensable pour récupérer le résultat des macros */
  5.  
  6. signal on error     /* pour l'interception des erreurs */
  7. signal on syntax
  8.  
  9. c=1
  10. 'SAVEALL(-1):UNMARK(-1):OBJECTS(-1)'; objets=result
  11. 'DEF UNMARKCOMP(O)=IF(GETREF(O),UNMARK(GETREF(O)),0):IF(GETVAL(O),UNMARK(GETVAL(O)),0):UNMARK(O)'
  12.  
  13. modifs=0; eliminations=0; errrefs=0; errvals=0; errconx=0; doublets=0
  14. c="Test du schéma"||'0a'x||"1- Vérifier les références "||'0a'x||"2- Vérifier les valeurs    "||'0a'x||"3- Vérifier les connexions "||'0a'x||"4- Vérifier les liaisons   "||'0a'x||"5- Tester présence doublons"||'0a'x
  15. c=c||"6- Enchaîner tous les tests"||'0a'x||"7- Abandonner              "
  16. 'SELECT("'c'")'
  17. c=result
  18. select
  19.     when c=1 then call test_refs
  20.     when c=2 then call test_valeurs
  21.     when c=3 then call test_connexions
  22.     when c=4 then call test_liaisons
  23.     when c=5 then call test_doublets
  24.     when c=6 then do
  25.     call test_doublets
  26.     call test_refs
  27.     call test_valeurs
  28.     call test_connexions
  29.     call test_liaisons
  30.     end
  31.     otherwise exit
  32. end
  33. call afficher_erreurs
  34. exit
  35.  
  36. test_refs:
  37.     'LOCK(-1):TITLE("Vérification des références...")'
  38.     do i=1 to objets
  39.     'TYPE(O='i')'
  40.     if result=1 then do
  41.         'PARTNAME(O)'
  42.         if result~="ALIMENTATION" & result ~="MASSE" then do
  43.         'GETREF(O)'
  44.         if result=0 then do
  45.             'MARK(O):REQUEST("Attention l''objet 'i'"+CHR(10)+"("+PARTNAME(O)+")"+CHR(10)+"situé en "+STR(COL(O))+" "+STR(LINE(O))+CHR(10)+"n''a pas de référence"+CHR(10)+"Voulez-vous continuer?")'
  46.             if result<1 then do
  47.             'UNLOCK(-1)'
  48.             return
  49.             end
  50.             'UNMARKCOMP(O)'
  51.             errrefs=errrefs+1
  52.         end
  53.         end
  54.     end
  55.     end
  56.     'UNLOCK(-1)'
  57. return
  58.  
  59. test_valeurs:
  60.     'LOCK(-1):TITLE("Vérification des valeurs..."):UNMARK(-1)'
  61.     do i=1 to objets
  62.     'TYPE(O='i')'
  63.     if result=1 then do
  64.         'PARTNAME(O)'
  65.         if result~="ALIMENTATION" & result ~="MASSE" then do
  66.         'GETVAL(O)'
  67.         if result=0 then do
  68.             'MARK(O):REQUEST("Attention l''objet 'i'"+CHR(10)+"("+PARTNAME(O)+")"+CHR(10)+"situé en "+STR(COL(O))+" "+STR(LINE(O))+CHR(10)+"n''a pas de valeur"+CHR(10)+"Voulez-vous continuer?")'
  69.             if result<1 then do
  70.             'UNLOCK(-1)'
  71.             return
  72.             end
  73.             'UNMARKCOMP(O)'
  74.             errvals=errvals+1
  75.         end
  76.         end
  77.     end
  78.     end
  79.     'UNLOCK(-1)'
  80. return
  81.  
  82. test_doublets:
  83.     'LOCK(-1):TITLE("Vérification absence éléments doubles..."):UNMARK(-1)'
  84.     i=1
  85.     do while i>0
  86.     'O=FINDOBJ('i',1,-1,-1)'; i=result
  87.     if i>0 then do
  88.         'N=FINDOBJ('i+1',1,COL(O),LINE(O))'; j=result
  89.         if j>0 then do
  90.         'IF(PARTNAME(O)==PARTNAME(N),IF(GETREF(N),DELETE(GETREF(N)),0):IF(GETVAL(N),DELETE(GETVAL(N)),0):DELETE(N):MARK(O),0):OBJECTS(-1)'; objets=result
  91.         doublets=doublets+1
  92.         end
  93.         if i>=objets-1 then i=0
  94.         else i=i+1
  95.     end
  96.     end
  97.     i=1
  98.     do while i>0
  99.     'O=FINDOBJ('i',1,-1,-1)'; i=result
  100.     if i>0 then do
  101.         'GETREF(O)'; r=result
  102.         if r>0 then do
  103.         'D=FINDREF('i+1',READTEXT(GETREF(O)))'; d=result
  104.         if d>0 then do
  105.             'MARK(O,D):MESSAGE("Attention: la référence"+CHR(10)+READTEXT(GETREF(O))+CHR(10)+"est utilisée deux fois!")'
  106.         end
  107.         end
  108.         if i>=objets-1 then i=0
  109.         else i=i+1
  110.     end
  111.     end
  112.     'UNLOCK(-1)'
  113. return
  114.  
  115. test_connexions:
  116.     'LOCK(-1):TITLE("Vérification des liaisons aux composants..."):UNMARK(-1)'
  117.     i=1
  118.     do while i>0
  119.     'O=FINDOBJ('i',1,-1,-1)'; i=result
  120.     if i>0 then do
  121.         'PARTNAME(O)'
  122.         'DEVPINS(O)'; j=result
  123.         do k=1 to j
  124.         if connexion_broche(i,k)=0 then do
  125.             'MARK(O):REQUEST("Attention l''objet 'i'"+CHR(10)+"("+PARTNAME(O)+")"+CHR(10)+"situé en "+STR(COL(O))+" "+STR(LINE(O))+CHR(10)+"a sa borne "+STR(IF(PINNUM(O,'k'),PINNUM(O,'k'),'k'))+" non connectée"+CHR(10)+"Voulez-vous continuer?")'
  126.             if result<1 then do
  127.             'UNLOCK(-1)'
  128.             return
  129.             end
  130.             'UNMARKCOMP(O)'
  131.             errconx=errconx+1
  132.         end
  133.         end
  134.         if i=objets then leave
  135.         i=i+1
  136.     end
  137.     end
  138.     'UNLOCK(-1)'
  139. return
  140.  
  141. test_liaisons:
  142.     'LOCK(-1):TITLE("Recherche et élimination lignes inutiles...")'
  143.     i=1
  144.     do while i>0
  145.     'O=FINDOBJ('i',2,-1,-1)'; i=result
  146.     if i>0 then do
  147.         'IF((COL(O)==ENDCOL(O))&(LINE(O)==ENDLINE(O)),DELETE(O),0)'
  148.         if result>0 then do
  149.         objets=result
  150.         eliminations=eliminations+1
  151.         end
  152.         else if i<objets then do
  153.         'IF(COL(O)==ENDCOL(O),1,IF(LINE(O)==ENDLINE(O),2,0))'
  154.         if result=1 then do    /* c'est une ligne verticale */
  155.             l=i+1
  156.             do while l>0
  157.             'L=FINDOBJ('l',2,COL(O),-1)'; l=result
  158.             if l>0 then do
  159.                 'IF(COL(L)==ENDCOL(L),COORDS(O)+","+COORDS(L),"")'
  160.                 if result~="" then do
  161.                 parse var result x0','y0','x1','y1','x2','y2','x3','y3
  162.                 y4=min(y0,y1)
  163.                 y5=max(y0,y1)
  164.                 y6=min(y2,y3)
  165.                 y7=max(y2,y3)
  166.                 if y4<y7 & y5>y6 then call modifier_lignes(x0,min(y4,y6),x0,max(y5,y7))
  167.                 else if y4=y7 then do
  168.                     'FINDOBJ(1,7,'x0','y4')'
  169.                     if result=0 then call modifier_lignes(x0,y6,x0,y5)
  170.                 end
  171.                 else if y5=y6 then do
  172.                     'FINDOBJ(1,7,'x0','y5')'
  173.                     if result=0 then call modifier_lignes(x0,y4,x0,y7)
  174.                 end
  175.                 end
  176.             end
  177.             if l>0 then do
  178.                 if l>=objets then l=0
  179.                 else l=l+1
  180.             end
  181.             end
  182.         end
  183.         else if result=2 then do    /* c'est une ligne horizontale */
  184.             l=i+1
  185.             do while l>0
  186.             'L=FINDOBJ('l',2,-1,LINE(O))'; l=result
  187.             if l>0 then do
  188.                 'IF(LINE(L)==ENDLINE(L),COORDS(O)+","+COORDS(L),"")' /* est-ce bien une ligne horizontale? */
  189.                 if result~="" then do
  190.                 parse var result x0','y0','x1','y1','x2','y2','x3','y3
  191.                 x4=min(x0,x1)
  192.                 x5=max(x0,x1)
  193.                 x6=min(x2,x3)
  194.                 x7=max(x2,x3)
  195.                 if x4<x7 & x5>x6 then call modifier_lignes(min(x4,x6),y0,max(x5,x7),y0)
  196.                 else if x4=x7 then do
  197.                     'FINDOBJ(1,7,'x4','y0')'
  198.                     if result=0 then call modifier_lignes(x6,y0,x5,y0)
  199.                 end
  200.                 else if x5=x6 then do
  201.                     'FINDOBJ(1,7,'x5','y0')'
  202.                     if result=0 then call modifier_lignes(x4,y0,x7,y0)
  203.                 end
  204.                 end
  205.             end
  206.             if l>0 then do
  207.                 if l>=objets then l=0
  208.                 else l=l+1
  209.             end
  210.             end
  211.         end
  212.         end
  213.         if i>=objets-1 then i=0
  214.         else i=i+1
  215.     end
  216.     else leave
  217.     end
  218.     'UNLOCK(-1)'
  219. return
  220.  
  221. afficher_erreurs:
  222.     if eliminations=0 & modifs=0 & errrefs=0 & errvals=0 & errconx=0 & doublets=0 then 'MESSAGE("Vérification terminée"+CHR(10)+"Aucune erreur trouvée")'
  223.     else do
  224.     t=""
  225.     if eliminations>0 then t=eliminations||" lignes nulles éliminées"
  226.     if modifs>0 then do
  227.         if t~="" then t=t||'0a'x||modifs||" lignes modifiées"
  228.         else t=modifs||" lignes modifiées"
  229.     end
  230.     if errrefs>0 then do
  231.         if t~="" then t=t||'0a'x||errrefs||" références manquantes"
  232.         else t=errrefs||" références manquantes"
  233.     end
  234.     if errvals>0 then do
  235.         if t~="" then t=t||'0a'x||errvals||" valeurs manquantes"
  236.         else t=errvals||" valeurs manquantes"
  237.     end
  238.     if errconx>0 then do
  239.         if t~="" then t=t||'0a'x||errconx||" connexions manquantes"
  240.         else t=errconx||" connexions manquantes"
  241.     end
  242.     if doublets>0 then do
  243.         if t~="" then t=t||'0a'x||doublets||" éléments supprimés"
  244.         else t=doublets||" éléments supprimés"
  245.     end
  246.     'MESSAGE("'t'")'
  247.     end
  248.     return
  249.  
  250. modifier_lignes:
  251.     parse arg xd,yd,xf,yf
  252.     'DRAWMODE(1):DELETE(L):DELETE(O):MARK(DRAW('xd','yd','xf','yf'))'
  253.     objets=objets-1
  254.     i=0; l=0
  255.     modifs=modifs+1
  256.     return
  257.  
  258. connexion_broche: procedure
  259.     parse arg objet,broche
  260.     'PINCOL(O='objet',B='broche')'; xj=result
  261.     'PINLINE(O,B)'; yj=result
  262.     'FINDOBJ(1,2,'xj','yj')'; xl=result     /* Il y a t'il une ligne qui part de la broche? */
  263.     if xl>0 then return xl
  264.     'FINDLINE(1,'xj','yj')'; xl=result      /* Il y a peut être une ligne qui passe SUR la broche... */
  265.     if xl<=0 then return 0
  266.     'FINDOBJ(1,7,'xj','yj')'                /* Il doit alors y avoir une jonction */
  267.     if result>0 then return xl
  268.     return 0
  269.  
  270. min: procedure
  271.     parse arg v1,v2
  272.     if v1<v2 then return v1
  273.     return v2
  274.  
  275. max: procedure
  276.     parse arg v1,v2
  277.     if v1>v2 then return v1
  278.     return v2
  279.  
  280. /* Traitement des erreurs, interruption du programme */
  281. syntax:
  282. erreur=RC
  283. 'MESSAGE("Erreur de syntaxe"+CHR(10)+"en ligne 'SIGL'"+CHR(10)+"'errortext(erreur)'")'
  284. exit
  285.  
  286. error:
  287. 'MESSAGE("Erreur en ligne 'SIGL'")'
  288. exit
  289.